unit WinTunClass;

interface
uses
  System.SysUtils,
  System.Classes,
  Winapi.Windows,
  Winapi.Winsock,
  Winapi.IpHlpApi,
  SYSTEM.Types,
  wintun;

const
  AF_INET = 2;     // IPv4 地址
  AF_INET6 = 23;   // IPv6 地址
type
  // 用于表示 IPv4 地址的 SOCKADDR 结构
  SOCKADDR_IN = record
    sin_family: Word;
    sin_port: Word;
    sin_addr: DWORD;
    sin_zero: array[0..7] of Byte;
  end;
  // 用于表示 IPv6 地址的 SOCKADDR 结构
  SOCKADDR_IN6 = record
    sin6_family: Word;
    sin6_port: Word;
    sin6_flowinfo: DWORD;
    sin6_addr: array[0..15] of Byte;
    sin6_scope_id: DWORD;
  end;
  // 表示 IP 地址（支持 IPv4 和 IPv6）的联合类型
  SOCKADDR_INET = record
    case Integer of
      0: (Ipv4: SOCKADDR_IN);
      1: (Ipv6: SOCKADDR_IN6);
  end;
  // MIB_UNICASTIPADDRESS_ROW 结构
  MIB_UNICASTIPADDRESS_ROW = record
    Address: SOCKADDR_INET;
    InterfaceLuid: UInt64;
    InterfaceIndex: ULONG;
    PrefixOrigin: Integer;
    SuffixOrigin: Integer;
    ValidLifetime: ULONG;
    PreferredLifetime: ULONG;
    OnLinkPrefixLength: BYTE;
    SkipAsSource: Boolean;
    DadState: Integer;
    ScopeId: ULONG;
    CreationTimeStamp: Int64;
  end;

    // 定义一个 DNS 地址列表结构
  TArrayOfSockAddr = array of SOCKADDR_IN;

  WINTUN_ADAPTER_HANDLE = wintun.WINTUN_ADAPTER_HANDLE;
  NET_LUID = wintun.NET_LUID;

{ TWinRecvThread }


  IPacket = interface
    /// <summary>
    /// 数据包指针
    /// </summary>
    /// <returns></returns>
    /// <remarks>
    /// 该指针由接口管理，不需要调用ReleaseReceivePacket进行释放
    /// </remarks>
    function GetRecvPack:PByte;
    /// <summary>
    /// 数据包大小
    /// </summary>
    /// <returns></returns>
    function GetRecvSize:DWORD;
    /// <summary>
    /// 继续发送数据
    /// </summary>
    /// <param name="Packet"></param>
    procedure ContinueSendPacket(Packet: PByte);
    /// <summary>
    /// 释放AllocateSendPacket申请的数据包内存
    /// </summary>
    /// <param name="Packet">数据包指针</param>
    procedure ReleaseReceivePacket(Packet: PByte);
    /// <summary>
    /// 申请数据包内存
    /// </summary>
    /// <param name="PacketSize">数据包大小，不能大于WINTUN_MAX_IP_PACKET_SIZE</param>
    /// <returns>申请数据包指针</returns>
    function AllocateSendPacket(PacketSize: DWORD): PByte;
  end;
{ TWinPacket }

  TWinPacket = class(TInterfacedObject,IPacket)
  protected
    FAdapterSession: WINTUN_SESSION_HANDLE;
    FRecvPack:PByte;
    FSize:DWORD;
  public
    function GetRecvPack:PByte;
    function GetRecvSize:DWORD;
    procedure ContinueSendPacket(Packet: PByte);overload;
    procedure ReleaseReceivePacket(Packet: PByte);
    function AllocateSendPacket(PacketSize: DWORD): PByte;
    constructor Create(AdapterSession: WINTUN_SESSION_HANDLE;ARecvPack:PByte;ASize:DWORD);
    destructor Destroy; override;
  published

  end;

  TWinTunRecv = reference to procedure (PacketInterface:IPacket);

  TWinRecvThread = class(TThread)
  protected
    FAdapterWaitEvent: THandle;
    FAdapterSession: WINTUN_SESSION_HANDLE;
    FOnRecv :TWinTunRecv;
    procedure Execute;override;
    procedure OnEvent(PacketInterface:IPacket);
    function GetOnRecv: TWinTunRecv;
    procedure SetOnRecv(const Value: TWinTunRecv);
  public
    constructor Create(AdapterSession: WINTUN_SESSION_HANDLE);
    destructor Destroy; override;
    /// <summary>
    /// 收发回调
    /// </summary>
    property OnRecv: TWinTunRecv read GetOnRecv write SetOnRecv;
  published

  end;

{ TWinTunAdapter }

  TWinTunAdapter = class(TObject)
  protected
    FAdapter:WINTUN_ADAPTER_HANDLE;
  public
    /// <summary>
    /// 获取适配器句柄
    /// </summary>
    /// <returns></returns>
    function GetAdaperHandle():WINTUN_ADAPTER_HANDLE;
    /// <summary>
    /// 获取UID
    /// </summary>
    /// <returns></returns>
    function GetLUID:NET_LUID;
    /// <summary>
    /// 设置适配器的IP地址和子网掩码
    /// </summary>
    /// <param name="IpAddress">IP地址</param>
    /// <param name="Mask">子网掩码</param>
    /// <returns></returns>
    function SetIpAddress(IpAddress:string;Mask:DWORD):boolean;
    /// <summary>
    /// 适配器句柄
    /// </summary>
    property AdapterHandle:WINTUN_ADAPTER_HANDLE read GetAdaperHandle;
    constructor Create(Name, TunnelType: PWideChar; RequestedGUID: PGUID);
    destructor Destroy; override;
  published
    /// <summary>
    /// 适配器UID
    /// </summary>
    property LUID:NET_LUID read GetLUID;
  end;


  IWinTun = interface
    /// <summary>
    /// 获取适配器对象
    /// </summary>
    function GetAdapter: TWinTunAdapter;
    /// <summary>
    /// 设置适配器对象
    /// </summary>
    procedure SetAdapter(const Value: TWinTunAdapter);
    /// <summary>
    /// 获取适配器类型字符串
    /// </summary>
    function GetAdapterTunnelType: string;
    /// <summary>
    /// 设置适配器类型字符串
    /// </summary>
    procedure SetAdapterTunnelType(const Value: string);
    /// <summary>
    /// 获取适配器名称
    /// </summary>
    function GetAdapterName: String;
    /// <summary>
    /// 设置适配器名称
    /// </summary>
    procedure SetAdapterName(const Value: String);
    /// <summary>
    /// 获取数据回调
    /// </summary>
    function GetOnRecv: TWinTunRecv;
    /// <summary>
    /// 设置数据回调
    /// </summary>
    procedure SetOnRecv(const Value: TWinTunRecv);
    /// <summary>
    /// 获取当前驱动版本
    /// </summary>
    function GetRunningDriverVersion: DWORD;
    /// <summary>
    /// 启用
    /// </summary>
    function Open:Boolean;
    /// <summary>
    /// 关闭
    /// </summary>
    procedure Close;
    /// <summary>
    /// 数据收发回调
    /// </summary>
    property OnRecv: TWinTunRecv read GetOnRecv write SetOnRecv;
    /// <summary>
    /// 适配器名称
    /// </summary>
    property AdapterName: String read GetAdapterName write SetAdapterName;
    /// <summary>
    /// 适配器类型名称
    /// </summary>
    property AdapterTunnelType: string read GetAdapterTunnelType write SetAdapterTunnelType;
    /// <summary>
    /// 适配器对象
    /// </summary>
    property Adapter: TWinTunAdapter read GetAdapter write SetAdapter;
    /// <summary>
    /// 驱动版本
    /// </summary>
    property RunningDriverVersion:DWORD read GetRunningDriverVersion;
  end;

{ TWinTun }

  TWinTun = class(TInterfacedObject,IWinTun)
  protected
    FAdapterName:string;
    FAdapterTunnelType:string;
    FAdapter:TWinTunAdapter;
    FAdapterThread:TWinRecvThread;
    FSession:WINTUN_SESSION_HANDLE;
    FOnRecv :TWinTunRecv;
    procedure RecvCallBack(PacketInterface:IPacket);
  public
    /// <summary>
    /// 获取连接对象
    /// </summary>
    function GetAdapter: TWinTunAdapter; virtual;
    /// <summary>
    /// 设置连接对象
    /// </summary>
    procedure SetAdapter(const Value: TWinTunAdapter); virtual;
    /// <summary>
    /// 获取连接类型字符串
    /// </summary>
    function GetAdapterTunnelType: string; virtual;
    /// <summary>
    /// 设置连接类型字符串
    /// </summary>
    procedure SetAdapterTunnelType(const Value: string); virtual;
    /// <summary>
    /// 获取连接名称
    /// </summary>
    function GetAdapterName: String; virtual;
    /// <summary>
    /// 设置连接名称
    /// </summary>
    procedure SetAdapterName(const Value: String); virtual;
    /// <summary>
    /// 获取数据回调
    /// </summary>
    function GetOnRecv: TWinTunRecv;virtual;
    /// <summary>
    /// 设置数据回调
    /// </summary>
    procedure SetOnRecv(const Value: TWinTunRecv);virtual;
    /// <summary>
    /// 获取当前驱动版本
    /// </summary>
    function GetRunningDriverVersion: DWORD; virtual;
    /// <summary>
    /// 启用
    /// </summary>
    function Open:Boolean;
    /// <summary>
    /// 关闭
    /// </summary>
    procedure Close;

    constructor Create;
    destructor Destroy; override;
  published
    /// <summary>
    /// 数据收发回调
    /// </summary>
    property OnRecv: TWinTunRecv read GetOnRecv write SetOnRecv;
    /// <summary>
    /// 连接名称
    /// </summary>
    property AdapterName: String read GetAdapterName write SetAdapterName;
    /// <summary>
    /// 连接类型名称
    /// </summary>
    property AdapterTunnelType: string read GetAdapterTunnelType write SetAdapterTunnelType;
    /// <summary>
    /// 连接对象
    /// </summary>
    property Adapter: TWinTunAdapter read GetAdapter write SetAdapter;
    /// <summary>
    /// 驱动版本
    /// </summary>
    property RunningDriverVersion:DWORD read GetRunningDriverVersion;
  end;

function ConvertInterfaceLuidToInterfaceIndex(const InterfaceLuid: NET_LUID; out InterfaceIndex: ULONG): DWORD; stdcall; external 'Iphlpapi.dll' name 'ConvertInterfaceLuidToIndex';
function CreateUnicastIpAddressEntry(const Row: MIB_UNICASTIPADDRESS_ROW): DWORD; stdcall; external 'iphlpapi.dll' name 'CreateUnicastIpAddressEntry';
implementation

{ TWinTun }

procedure TWinTun.Close;
begin
  FAdapterThread.free;
  WintunEndSession(FSession);
  FAdapter.Free;
end;

constructor TWinTun.Create;
begin

end;

destructor TWinTun.Destroy;
begin
  try
    WintunDeleteDriver;
  finally

  end;

  inherited;
end;

function TWinTun.GetAdapter: TWinTunAdapter;
begin
  Result := FAdapter;
end;

function TWinTun.GetAdapterName: String;
begin
  Result := FAdapterName;
end;

function TWinTun.GetAdapterTunnelType: string;
begin
  Result := FAdapterTunnelType;
end;


function TWinTun.GetOnRecv: TWinTunRecv;
begin
  Result := FOnRecv;
end;

function TWinTun.GetRunningDriverVersion: DWORD;
begin
  Result := WintunGetRunningDriverVersion;
end;

function TWinTun.Open: Boolean;
begin
  Result := False;

  FAdapter := TWinTunAdapter.Create(PWideChar(FAdapterName),PWideChar(FAdapterTunnelType),nil);
  if FAdapter.AdapterHandle = nil then
  begin
    FAdapter.Free;
    raise Exception.Create(Format('TWinTunAdapter Error!Error Code:%s',[GetLastError.tostring]));
  end;

  FSession := WintunStartSession(FAdapter.AdapterHandle,$2000000);
  if FSession = nil then
  begin
    FAdapter.Free;
    raise Exception.Create(Format('WintunStartSession Error!Error Code:%s',[GetLastError.tostring]));
  end;

  FAdapterThread := TWinRecvThread.Create(FSession);
  FAdapterThread.OnRecv := RecvCallBack;
  Result := True;

end;

procedure TWinTun.RecvCallBack(PacketInterface: IPacket);
begin
  if Assigned(FOnRecv) then
    FOnRecv(PacketInterface);
end;

procedure TWinTun.SetAdapter(const Value: TWinTunAdapter);
begin
  FAdapter := Value;
end;

procedure TWinTun.SetAdapterName(const Value: String);
begin
  FAdapterName := Value;
end;

procedure TWinTun.SetAdapterTunnelType(const Value: string);
begin
  FAdapterTunnelType := Value;
end;

procedure TWinTun.SetOnRecv(const Value: TWinTunRecv);
begin
  FOnRecv := Value;
end;

{ TWinTunAdapter }

constructor TWinTunAdapter.Create(Name, TunnelType: PWideChar;
  RequestedGUID: PGUID);
begin
   FAdapter := WintunCreateAdapter(Name, TunnelType,RequestedGUID);
end;

destructor TWinTunAdapter.Destroy;
begin
  WintunCloseAdapter(FAdapter);
  FAdapter := nil;
  inherited;
end;

function TWinTunAdapter.GetAdaperHandle: WINTUN_ADAPTER_HANDLE;
begin
  Result := FAdapter;
end;

function TWinTunAdapter.GetLUID: NET_LUID;
begin
  WintunGetAdapterLUID(FAdapter,Result);
end;

function TWinTunAdapter.SetIpAddress(IpAddress:string;Mask:DWORD): boolean;
var
  Row: MIB_UNICASTIPADDRESS_ROW;
  ResultCode: DWORD;
  InterfaceIndex: ULONG;
begin
  // 初始化结构体
  FillChar(Row, SizeOf(Row), 0);
  // 设置 IPv4 地址
  Row.Address.Ipv4.sin_family := AF_INET;
  Row.Address.Ipv4.sin_addr := inet_addr(PAnsiChar(AnsiString(IpAddress))); // 设置具体的 IPv4 地址
  ROW.OnLinkPrefixLength := Mask;
  // 设置网络接口标识符（这里用接口索引）
  ConvertInterfaceLuidToInterfaceIndex(GetLUID,InterfaceIndex);
  Row.InterfaceIndex := InterfaceIndex; // 替换为实际的网络接口索引
  Row.InterfaceLuid := GetLUID.Value;
  // 配置生命周期
  Row.ValidLifetime := $FFFFFFFF; // 无限生命周期
  Row.PreferredLifetime := $FFFFFFFF; // 无限生命周期
  // 配置地址来源
  Row.PrefixOrigin := 1; // IpPrefixOriginManual
  Row.SuffixOrigin := 1; // IpSuffixOriginManual
  // 添加单播 IP 地址
  ResultCode := CreateUnicastIpAddressEntry(Row);

end;

{ TWinRecvThread }

constructor TWinRecvThread.Create(AdapterSession: WINTUN_SESSION_HANDLE);
begin
  FAdapterWaitEvent :=  WintunGetReadWaitEvent(AdapterSession);
  FAdapterSession := AdapterSession;
  inherited Create(False);
end;

destructor TWinRecvThread.Destroy;
begin
  Terminate;
  WaitFor;
  inherited;
end;

procedure TWinRecvThread.Execute;
var
  WaitResult: DWORD;
  PacketSize: DWORD;
  Packet:PByte;
begin
  while NOT Terminated do
  begin
    WaitResult := WaitForSingleObject(FAdapterWaitEvent, 1000);
    case WaitResult of
      WAIT_OBJECT_0:
      BEGIN
        Packet := WintunReceivePacket(FAdapterSession,PacketSize);
        if Packet <> nil then
          OnEvent(TWinPacket.Create(FAdapterSession,Packet,PacketSize));
      END;
      WAIT_TIMEOUT:
      BEGIN
        if Terminated then
          Exit;
      END;
    end;
  end;
end;

function TWinRecvThread.GetOnRecv: TWinTunRecv;
begin
  Result := FOnRecv;
end;

procedure TWinRecvThread.OnEvent(PacketInterface:IPacket);
begin
  if Assigned(FOnRecv) then
    FOnRecv(PacketInterface);
//  PacketInterface.ContinueSendPacket(PacketInterface.GetRecvPack);
end;

procedure TWinRecvThread.SetOnRecv(const Value: TWinTunRecv);
begin
  FOnRecv := Value;
end;

{ TWinPacket }

constructor TWinPacket.Create(AdapterSession: WINTUN_SESSION_HANDLE;ARecvPack: PByte; ASize: DWORD);
begin
  FAdapterSession := AdapterSession;
  FRecvPack := ARecvPack;
  FSize := ASize;
end;

destructor TWinPacket.Destroy;
begin
  WintunReleaseReceivePacket(FAdapterSession,FRecvPack);
  inherited;
end;

function TWinPacket.GetRecvPack: PByte;
begin
  Result := FRecvPack;
end;

function TWinPacket.GetRecvSize: DWORD;
begin
  Result := FSize;
end;

function TWinPacket.AllocateSendPacket(PacketSize: DWORD): PByte;
begin
  Result := WintunAllocateSendPacket(FAdapterSession,PacketSize);
end;

procedure TWinPacket.ReleaseReceivePacket(Packet: PByte);
begin
  WintunReleaseReceivePacket(FAdapterSession,Packet);
end;

procedure TWinPacket.ContinueSendPacket(Packet: PByte);
begin
  WintunSendPacket(FAdapterSession,Packet);
end;

end.
